home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / locf.c < prev    next >
C/C++ Source or Header  |  1992-11-21  |  2KB  |  76 lines
  1. /* locf.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  12.         sfactr;
  13.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  14.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  15. } status_;
  16.  
  17. #define status_1 status_
  18.  
  19. /* Table of constant values */
  20.  
  21. static integer c__1 = 1;
  22.  
  23. /*<       integer function locf(ivar) >*/
  24. integer locf_(ivar)
  25. integer *ivar;
  26. {
  27.     /* Format strings */
  28.     static char fmt_100[] = "(\0020*error*: system error, address \002,i10\
  29. ,\002 is not on 4-byte boundary\002)";
  30.  
  31.     /* System generated locals */
  32.     integer ret_val;
  33.  
  34.     /* Builtin functions */
  35.     integer s_wsfe(), do_fio(), e_wsfe();
  36.  
  37.     /* Local variables */
  38.     static integer iabsa;
  39.     extern integer loc_();
  40.  
  41.     /* Fortran I/O blocks */
  42.     static cilist io__2 = { 0, 0, 0, fmt_100, 0 };
  43.  
  44.  
  45.     /* Parameter adjustments */
  46.     --ivar;
  47.  
  48.     /* Function Body */
  49. /*<       implicit double precision (a-h,o-z) >*/
  50. /*<       external loc >*/
  51. /* spice version 2g.6  sccsid=status 3/15/83 */
  52. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  53. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  54. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  55. /*<       dimension ivar(1) >*/
  56. /*<       iabsa=loc(ivar) >*/
  57.     iabsa = loc_(&ivar[1]);
  58. /*<       locf=iabsa/4 >*/
  59.     ret_val = iabsa / 4;
  60. /*<       if (iabsa.eq.4*locf) return >*/
  61.     if (iabsa == ret_val << 2) {
  62.     return ret_val;
  63.     }
  64. /*<       write(iofile,100) iabsa >*/
  65.     io__2.ciunit = status_1.iofile;
  66.     s_wsfe(&io__2);
  67.     do_fio(&c__1, (char *)&iabsa, (ftnlen)sizeof(integer));
  68.     e_wsfe();
  69. /*<   100 format ('0*error*: system error, address ',i10, >*/
  70. /*<      1   ' is not on 4-byte boundary') >*/
  71. /*<       return >*/
  72.     return ret_val;
  73. /*<       end >*/
  74. } /* locf_ */
  75.  
  76.